home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Demos / demo_dbuf < prev    next >
Encoding:
Text File  |  1992-02-07  |  4.5 KB  |  201 lines
  1. \ Display IFF and other graphics using
  2. \ Single and Double Buffering
  3. \
  4. \ Note that with single buffering, you can see the picture being drawn.
  5. \
  6. \ Author: Phil Burk
  7. \ Copyright: Phil Burk 1991
  8. \
  9. \ 00001 PLB 1/28/92 Changed SAVE/BACKUP
  10. \ 00002 PLB 2/8/92 Changed 5 DDB_NUM_COLORS to 3 DDB_NUM_PLANES
  11.  
  12. include? $pic.load jiff:load_pic
  13. include? dbuf.make0 jiff:double_buffer
  14. include? ?goto.error ju:goto_error
  15.  
  16. ANEW TASK-DEMO_DBUF
  17.  
  18. \ You may change these names to match IFF files you have created!
  19. : BACKG_FILENAME ( -- $name ) " jpics:mountains.pic" ;
  20. : BRUSH1_FILENAME (  -- $name ) " jpics:comet.br" ;
  21. : BRUSH2_FILENAME (  -- $name ) " jpics:ship.br" ;
  22.  
  23. ." Will Read BACKG   from: " BACKG_FILENAME count type cr
  24. ." Will Read BRUSH1  from: " BRUSH1_FILENAME count type cr
  25. ." Will Read BRUSH1  from: " BRUSH2_FILENAME count type cr
  26.  
  27. \ You must change these values if your pictures have
  28. \ a different number of planes or a different size.
  29. 3 constant DDB_NUM_PLANES \ 00002
  30. 320 constant DDB_WIDTH
  31. 200 constant DDB_HEIGHT
  32.  
  33. \ used by random walk
  34. variable DDB-BX-1
  35. variable DDB-BY-1
  36. variable DDB-BX-2
  37. variable DDB-BY-2
  38.  
  39. \ declare IFF picture structures
  40. picture ddb-backg
  41. picture ddb-brush1
  42. picture ddb-brush2
  43.  
  44. \ Set flags for SCREEN>BACKWINDOW which is called by DBUF.MAKE0
  45.  
  46. BACKDROP BORDERLESS | WINDOWCLOSE | REPORTMOUSE | -> S>B_FLAGS
  47. MOUSEBUTTONS CLOSEWINDOW | -> S>B_IDCMPFLAGS \ Cannot be zero
  48.     
  49. : DDB.INIT.SCREENS ( -- error? , open screen and window for 1st buffer)
  50. \ open a screen with a backdrop window
  51.     ddb_num_planes ddb_width ddb_height 0 dbuf.make0 0= \ 00002
  52.     IF
  53. \ The IFF code will open a new screen if SIFF-SCREEN is zero.
  54. \ This will force it to use the screen you opened.
  55.         dbuf-screen @ siff-screen !   \ don't open another screen!
  56. \
  57. \ Load the IFF pictures.
  58.         backg_filename ddb-backg $pic.load? ?goto.error
  59.         brush1_filename ddb-brush1 $pic.load? ?goto.error
  60.         brush2_filename ddb-brush2 $pic.load? ?goto.error
  61. \
  62. \ Make the screen use the picture's color map.
  63.         ddb-backg pic.use.colors
  64. \
  65. \ Show full backdrop window by hiding SIFF-SCREEN title.
  66.         siff.showit
  67.     THEN
  68.     FALSE exit
  69. \
  70. ERROR:
  71.     >newline ." Error loading pictures!" cr
  72.     TRUE
  73. ;
  74.  
  75. : D1B.INIT ( -- error )
  76.     ddb.init.screens ?goto.error
  77.     0 0 ddb-backg pic.blit  \ set background
  78. \
  79. \ allocate room for saving background
  80.     0 ddb-brush1 pic.alloc.backup? ?goto.error
  81.     0 ddb-brush2 pic.alloc.backup? ?goto.error
  82.     0 0 0 ddb-brush1 pic.backup.nth \ save initial background
  83.     0 0 0 ddb-brush2 pic.backup.nth \ save initial background
  84.     FALSE
  85.     exit
  86. \
  87. error:
  88.     TRUE
  89. ;
  90.  
  91. : DDB.TERM ( -- )
  92.     >newline ." DDB.TERM" cr
  93.     0 siff-screen !
  94.     ddb-backg pic.free
  95.     ddb-brush1 pic.free
  96.     ddb-brush2 pic.free
  97.     dbuf.unmake
  98. ;
  99.  
  100. if.forgotten ddb.term    \ in case we forget to
  101.  
  102. : DDB.WALK.BRUSH { xvar yvar pict -- }
  103. \ Choose an X,Y that may cause brush to be clipped against
  104. \ left or top edge.
  105.     11 choose 5 - xvar @ + -20 max 200 min ( x )
  106.     dup xvar !
  107.     11 choose 5 - yvar @ + -20 max 100 min ( y )
  108.     dup yvar !
  109. \
  110. \ save before drawing
  111.     2dup
  112.     dbuf-cur-buf @ \ currently displayed buffer
  113.     pict pic.backup.nth
  114. \
  115. \ now draw it transparently
  116.     pict pic.trans.blit
  117. ;
  118.  
  119. : DDB.DRAW  ( -- , draw a new image )
  120. \ restore image from previous draw
  121. \ These MUST be drawn in the reverse order that they are drawn!
  122.     dbuf-cur-buf @ \ currently displayed buffer
  123.     ddb-brush2 pic.restore.nth \ 2 2 2 2 2 2 2 2 2 2 2 !
  124. \
  125.     dbuf-cur-buf @ \ currently displayed buffer
  126.     ddb-brush1 pic.restore.nth \ 1 1 1 1 1 1 1 1 1 1 1 !
  127. \
  128.     ddb-bx-1 ddb-by-1 ddb-brush1 ddb.walk.brush \ 1 1 1 !
  129.     ddb-bx-2 ddb-by-2 ddb-brush2 ddb.walk.brush \ 2 2 2 !
  130. ;
  131.  
  132. : D1B.DRAW.LOOP ( -- )
  133.     BEGIN
  134.         ddb.draw
  135.         WaitTOF()
  136.         ?terminal
  137.         ?closebox OR
  138.     UNTIL
  139. ;
  140.  
  141. : D2B.DRAW.LOOP ( -- )
  142.     BEGIN
  143.         ddb.draw
  144.         dbuf.switch    \ Switch draw and display buffers
  145.         WaitTOF()      \ wait for view to settle
  146.         ?terminal
  147.         ?closebox OR
  148.     UNTIL
  149. ;
  150.  
  151. : DEMO.1BUF
  152.     gr.init
  153.     d1b.init 0=
  154.     IF
  155.         d1b.draw.loop
  156.     THEN
  157.     ddb.term
  158.     gr.term
  159. ;
  160.  
  161. : D2B.INIT ( -- error? )
  162.     true
  163.     d1b.init 0=
  164.     IF
  165. \ make second buffer
  166.         ddb_num_planes ddb_width ddb_height dbuf.make1 0= \ 00002
  167.         IF
  168.             0 0 ddb-backg pic.blit  \ set background
  169. \ allocate room for saving background
  170.             1 ddb-brush1 pic.alloc.backup? 0= \ 00001
  171.             IF
  172.                 1 ddb-brush2 pic.alloc.backup? 0= \ 00001
  173.                 IF
  174. \ save initial backgrounds
  175.                     0 0 1 ddb-brush1 pic.backup.nth \ 00001
  176.                     0 0 1 ddb-brush2 pic.backup.nth
  177.                     drop FALSE
  178.                 THEN
  179.             THEN
  180.         THEN
  181.     ELSE
  182.         ." D1B.INIT failed!" cr
  183.     THEN
  184. ;
  185.  
  186. : DEMO.2BUF
  187.     gr.init
  188.     d2b.init 0=
  189.     IF
  190.         d2b.draw.loop
  191.     THEN
  192.     ddb.term
  193.     gr.term
  194. ;
  195.  
  196. cr
  197. ." Enter:   DEMO.1BUF to see SINGLE buffered display" cr
  198. ." Enter:   DEMO.2BUF to see DOUBLE buffered display" cr
  199.  
  200.  
  201.